home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 025a / lotlib.zip / LOTLIB.PRG < prev    next >
Text File  |  1989-04-11  |  10KB  |  294 lines
  1. ** lotlib.prg
  2. ** Author: Nick Keenan, CIS Number 71641,2615
  3. ** Date: 4-11-89
  4. ** Copyright: (C) 1988,1989 Nicholas B. Keenan
  5.  
  6. ******************************************************************************
  7. *                                                                               
  8. *                                                                             
  9. *  This is a set of functions written in clipper to allow you to create      
  10. *  Lotus-123 type files as the output of your applications.  To some extent  
  11. *  it replaces the "copy type wks" command of dBase, but it allows you to go 
  12. *  much further in terms of specifying the exact format.
  13. *
  14. *  This file contains the functions, and an example program which demonstrates
  15. *  their use by copying a .dbf file to a .wk1 file.
  16. *
  17. *  The functions are:
  18.  
  19. *     lopen(filename) -- opens a file as a spreadsheet.
  20. *          Returns the dos handle on success, otherwise -1.
  21.  
  22. *     lwidth(handle, column, width) -- Sets the width of column (column+1)in 
  23. *          the worksheet pointed to by handle to width. Equivalent to /wcs
  24. *          in interactive lotus.
  25.  
  26. *     lput(handle,value,column,row) -- puts value in cell (column+1,row+1) in
  27. *          the worksheet pointed to by handle.  Makes certain assumptions about
  28. *          default formats (dates are long international, integers are comma,
  29. *          reals are fixed format, etc.) but you can adjust them.
  30.  
  31. *     lclose(handle) -- write the eof string to handle and close it.
  32.  
  33. *******************************************************************************
  34.  
  35.  
  36.  
  37. **                      How lotus files are organized                     **
  38.  
  39. **  A lotus worksheet file consists of a series of records, each of 4 or more
  40. **  bytes.  The first two bytes are an integer identifying the function of this
  41. **  record.  Typical functions are: 0x00 - beginning of file;0x08 - set column
  42. **  width; 0x0D - integer data; 0x0E - floating point data; 0x0F - string data;
  43. **  0x10 - formula; etc.  The next two bytes tell the length of the data portion
  44. **  of the record, if any, and the rest of the record is the data.
  45. **  I am indebted to "File Formats for Popular PC Software" by Jeff Walden, 
  46. **  Wiley Press, for this information, although it is also freely available
  47. **  from Lotus.
  48.  
  49. **  The only real problem with creating records of this type in clipper is the
  50. **  treatment of floating point numbers, which are required for values not 
  51. **  between -32767 and 32767 as well as for non-integers.  Basically what you
  52. **  need is a function that takes a number as its argument and returns an 
  53. **  eight character string that is the floating-point representation of that
  54. **  number.  This can be done in two ways: either in a simple C program using
  55. **  the extend system, or through a somewhat longer method in clipper.  For the
  56. **  sake of example, both methods are included in this file. In addition, there
  57. **  should be a file called cfloat.obj included in this archive, which is a
  58. **  compiled version of the C function which can be linked in directly if you
  59. **  don't have a C compiler.  I use the C version in my programs because it is
  60. **  faster and more elegant, although there is a certain cachet in having 
  61. **  something like this written entirely in clipper.
  62.  
  63.  
  64. ******************************************************************************
  65.  
  66. **                           N O T I C E                                    **
  67.  
  68.  
  69. **  This program, and the acompanying documentation and files, is released for
  70. **  the STRICT NON-COMMERCIAL use of others. If you intend to use any part of
  71. **  it for any commercial purpose, you MUST obtain the permission of the 
  72. **  copyright holder.  Portions of this code are currently being used in a
  73. **  commercial software product; if your product is not a competitor of ours,
  74. **  we will probably let you use it in your product.  In addition, we would
  75. **  like to hear comments, questions and additions  from anyone who uses
  76. **  these functions.
  77. **  Our address is: PO Box 2133, Hoboken, NJ, 07030. (201)963-1000.
  78.  
  79.  
  80. **                     H E L P   W A N T E D                              **
  81.  
  82. **  Could you write a program like this?  Could you write a better one?  Are
  83. **  you interested in working in Charlottesville, VA ?  Our company , a small
  84. **  but aggressive publishing/research/consulting partnership, specializing in
  85. **  financial intitutions, is looking for several experienced clipper 
  86. **  programmers to work as full-time employees starting in July of 1989.
  87. **  Job duties include producing and developing database and print 
  88. **  publications, supervising a local area network, user support, etc. We are
  89. **  big in desktop publishing and PC to fax broadcasting.  We are a young
  90. **  company (2 years old) where your capabilities will be tested and rewarded.
  91. **  We have no bureaucracy and dress casually.  If you are interested in 
  92. **  getting in on the bottom floor, and working in one of the prettiest cities
  93. **  in America (Charlottesville, not Hoboken), contact us in confidence
  94. **  at the address above.
  95.  
  96.  
  97. **  enough propaganda.  Here's the sample program.
  98.  
  99.  
  100.  
  101.  
  102. clear
  103. fname=space(8)
  104. @ 10,10 say "Input name of file to translate:" get fname
  105. read
  106. if lastkey() =27
  107.     quit
  108. endif
  109. if .not. file(fname+'.dbf')
  110.     ?'File not found'
  111.     quit
  112. endif
  113. if file(fname+'.wk1')
  114.     wait 'File '+fname+'.wk1 already exists. Overwrite Y/N ?' to ch
  115.     if upper(ch) != 'Y'
  116.         quit
  117.     endif
  118. endif
  119.  
  120. use &fname
  121. handle = lopen(fname)
  122. for x=1 to fcount()
  123.     fld=field(x)
  124.     do case
  125.         case type(fld) ='D'
  126.             lwidth(handle,x-1,9)
  127.         case type(fld) ='L'
  128.             lwidth(handle,x-1,2)
  129.         case type(fld) ='C'
  130.             lwidth(handle,x-1,len( &fld) ) 
  131.         case type(fld) ='N'
  132.             if getdecs(&fld) = 0
  133.                 lwidth(handle,x-1,int((len(str(&fld))+2)*4/3))  && make wide enough for commas
  134.             else
  135.                 lwidth(handle,x-1,len(str(&fld)))
  136.             endif
  137.     endcase
  138.     lput(handle,fld,x-1,0)  && put in labels
  139. next    
  140.  
  141.  
  142. do while .not. eof() .and. inkey() <>27
  143.     for x=1 to fcount()
  144.         fld=field(x)
  145.         lput(handle, &fld,x-1,recno())
  146.     next
  147.     @ 24,3 say str(recno())+" Records copied"
  148.     skip
  149. enddo
  150.  
  151. lclose(handle)
  152. return
  153.  
  154.  
  155. ******************************************************************************
  156. *** lotus interface funtions
  157.  
  158. ****************************************************
  159. ** lopen(file)
  160. ** open a file as a lotus worksheet
  161. ** returns  dos handle, -1 on error
  162.  
  163. FUNCTION lopen
  164. param fname
  165. private mname,handle
  166.  
  167. if  .not. "." $ fname
  168.     mname=trim(fname)+".wk1"
  169. else
  170.     mname=fname
  171. endif
  172. handle =fcreate(mname,0)
  173. ** put in bof string
  174. if handle <>-1
  175.     fwrite(handle,chr(0)+chr(0)+chr(2)+chr(0)+chr(6)+chr(4))
  176. endif
  177. return handle
  178.  
  179.  
  180. ************************************************************************
  181. *lwidth(handle,col,width)
  182. * set width of specified column to width in file handle
  183. FUNCTION lwidth
  184. param handle, col, width
  185. return fwrite(handle,chr(8)+chr(0)+chr(3)+chr(0)+lotwrd(col)+chr(width))
  186.  
  187.  
  188. **************************************************************************
  189. *lput(handle,val,col,row)
  190. * put a value into cell col, row 
  191. FUNCTION lput
  192. param handle,val,col,row
  193. private mstr, decs
  194.  
  195. do case
  196.     case type("val")="C"
  197.         mstr=chr(15)+chr(0)+lotwrd(len(val)+7)+chr(255)+lotwrd(col)+lotwrd(row)+"'"+val+chr(0)
  198.     case type("val")="D"
  199.         mstr=chr(14)+chr(0)+chr(13)+chr(0)+chr(249)+lotwrd(col)+lotwrd(row)+cfloat(val-ctod('01/01/00')+2)
  200.     case type("val")="N"
  201.         decs=getdecs(val)        
  202.         if decs <>0
  203.             mstr=chr(14)+chr(0)+chr(13)+chr(0)+chr(128+decs)+lotwrd(col)+lotwrd(row)+cfloat(val)
  204.         else
  205.             mstr=chr(14)+chr(0)+chr(13)+chr(0)+chr(192)+lotwrd(col)+lotwrd(row)+cfloat(val)
  206.         endif
  207.     case type("val")="L"
  208.         mstr=chr(15)+chr(0)+chr(8)+chr(0)+chr(255)+lotwrd(col)+lotwrd(row)+"'"+if(val,"Y","N")+chr(0)
  209. endcase
  210. return fwrite(handle,mstr)
  211.  
  212.  
  213. ********************************************************************************
  214. ****lclose(handle)
  215. ** close a lotus file
  216. FUNCTION lclose
  217. param handle
  218. fwrite(handle,chr(01)+chr(0)+chr(0)+chr(0)) 
  219. fclose(handle)
  220. return .t.
  221.  
  222. ************************************************************************************
  223. FUNCTION lotwrd
  224. ** returns the lotus format of a number (lsb first)
  225. param mvalue
  226. return chr(mvalue%256)+chr(int(mvalue/256))
  227.  
  228. FUNCTION getdecs
  229. ** get number of decimal places in a number
  230. param mnum
  231. private smnum, at
  232. smnum=str(mnum)
  233. at=at('.',smnum)
  234. if at=0
  235.     return 0
  236. else
  237.     return len(smnum)-at
  238. endif
  239.  
  240.  
  241. *******************************************************************************
  242. ** return the string form of a double
  243. ** offered as an alternative to the C version
  244.  
  245. function cfloat
  246. param var
  247. private retval, mantissa, sign ,x
  248. if var=0
  249.     return replicate(chr(0),8)
  250. endif
  251. if var <0
  252.     sign =128
  253. else
  254.     sign =0
  255. endif
  256. mantissa=1075
  257. var=abs(var)
  258. do while var < 4503599627370496
  259.     var=var*2
  260.     mantissa=mantissa-1
  261. enddo
  262. do while var > 2*4503599627370496-1
  263.     var=var/2
  264.     mantissa=mantissa+1
  265. enddo
  266. var=int(var)
  267. retval=''
  268. for x= 1 to 6
  269.     retval=retval+chr(var%256)
  270.     var=int(var/256)
  271. next
  272. var=var-16
  273.  
  274. retval=retval+chr(var+16*(mantissa%16))    
  275. retval=retval+chr(sign+int(mantissa/16))
  276. return retval
  277.  
  278. ********************************************************************
  279. **  The C version is much simpler:
  280.  
  281. **  #include "extend.h"
  282. **  
  283. **  CLIPPER cfloat()
  284. **  {
  285. **      double  flvar;
  286. **      char *x;
  287. **      flvar=_parnd(1);
  288. **      x=(char *)&flvar;
  289. **      _retclen(x,8);
  290. **  }
  291. *************************************************************************
  292.  
  293. **[EOF]
  294.